home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / PROMPT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  3KB  |  108 lines
  1. {$A+,B-,F-,L-,N-,O-,R-,S-,V-}
  2.  
  3. unit prompt;
  4.  
  5. {
  6.  
  7. Author:   Trevor J Carlsen
  8.           PO Box 568
  9.           Port Hedland
  10.           Western Australia 6721
  11.           61-[0]-91-73-2026  (voice)
  12.           61-[0]-91-73-2930  (data )
  13.           
  14. Released into the public domain.
  15.  
  16. This unit will automatically create a predefined prompt when shelling to DOS.
  17. If you wish to create your own custom prompt, all that is required is to give
  18. the variable NewPrompt another value and call the procedure ChangeShellPrompt.
  19.  
  20. }
  21.  
  22. interface
  23.  
  24. uses dos;
  25.  
  26. var
  27.   NewPrompt : string;
  28.  
  29. procedure ChangeShellPrompt(Nprompt: string);
  30.  
  31. implementation
  32.  
  33.  type
  34.    EnvArray  = array[0..32767] of byte;
  35.    EnvPtr    = ^EnvArray;
  36.  var
  37.    EnvSize, EnvLen, EnvPos: word;
  38.    NewEnv, OldEnv         : EnvPtr;
  39.    TempStr                : string;
  40.    x                      : word;
  41.  
  42.  procedure ChangeShellPrompt(Nprompt: string);
  43.  
  44.    function MainEnvSize: word;
  45.      var
  46.        x      : word;
  47.        found  : boolean;
  48.      begin
  49.        found  := false; x := 0;
  50.        repeat
  51.          if (OldEnv^[x] = 0) and (OldEnv^[x+1] = 0) then
  52.            found := true
  53.          else
  54.            inc(x);
  55.        until found;
  56.        MainEnvSize := x - 1;
  57.      end; { MainEnvSize}
  58.  
  59.    procedure AddEnvStr(var s; var offset: word; len: word);
  60.      var st : EnvArray absolute s;
  61.      begin
  62.        move(st[1],NewEnv^[offset],len);
  63.        inc(offset,len+1);
  64.      end;
  65.  
  66.  begin
  67.    OldEnv   := ptr(MemW[PrefixSeg:$2C],0);
  68.    { this gets the actual starting segment of the current program's env }
  69.  
  70.    EnvSize      :=  MemW[seg(OldEnv^)-1:3] shl 4;
  71.    { Find the size of the current environment }
  72.  
  73.    if MaxAvail < (EnvSize+256) then begin
  74.      writeln('Insufficient memory');
  75.      halt;
  76.    end;
  77.  
  78.    GetMem(NewEnv, EnvSize + $100);
  79.    if ofs(NewEnv^) <> 0 then begin
  80.       inc(longint(NewEnv),$10000 + ($10000 * (longint(NewEnv) div 16)));
  81.       longint(NewEnv) := longint(NewEnv) and $ffff0000;
  82.    end;
  83.    FillChar(NewEnv^,EnvSize + $100,0);
  84.    { Allocate heap memory for the new environment adding enough to allow }
  85.    { alignment to a paragraph boundary or a longer prompt than the default }
  86.    { and initialise to nuls }
  87.    EnvPos   := 0;
  88.  
  89.    AddEnvStr(Nprompt,EnvPos,length(Nprompt));
  90.    for x := 1 to EnvCount do begin
  91.      TempStr := EnvStr(x);
  92.      if TempStr <> GetEnv('PROMPT') then
  93.        AddEnvStr(TempStr,EnvPos,length(TempStr));
  94.    end; { for }
  95.    inc(EnvPos);
  96.    { Transfer old env strings except the prompt to new environment }
  97.  
  98.    if lo(DosVersion) > 2 then
  99.      AddEnvStr(OldEnv^[MainEnvSize + 2],EnvPos,EnvSize-(MainEnvSize + 2));
  100.    { Add the rest of the environment }
  101.  
  102.    MemW[PrefixSeg:$2C] := seg(NewEnv^);
  103.    { let the program know where the new environment is }
  104.  end;  { ChangeShellPrompt }
  105.  
  106. end.  { prompt }
  107.   
  108.